home *** CD-ROM | disk | FTP | other *** search
- ⓪ MODULE DhryTest;⓪ (*$E MOS *)⓪ (* [+*)⓪ (* ^-*)⓪ ⓪ (*$D+*)⓪ IMPORT TOSDebug;⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADR;⓪ FROM Storage IMPORT ALLOCATE;⓪ IMPORT TOSIO;⓪ FROM InOut IMPORT WriteString, WriteLn, WriteCard, WriteLHex, Read;⓪ FROM Strings IMPORT Compare, Relation;⓪ ⓪ FROM PrgCtrl IMPORT GetBasePageAddr;⓪ ⓪ (**** Compiler-/Library-abhängige Importe ****)⓪ ⓪$(* für time-Funktion, s.u. *)⓪$FROM XBIOS IMPORT SuperExec;⓪$FROM SYSTEM IMPORT ADDRESS;⓪ ⓪ ⓪ (**** Compiler-abhängige Direktiven ****)⓪ ⓪$(*$R- Megamax: no range checks *)⓪$(*$S- Megamax: no stack checks *)⓪$(*$Z+ Megamax: optimize for use of registers in function returns *)⓪ ⓪$(* I+ FTL: HIGH() returns CARDINAL (16 Bit) *)⓪ ⓪ ⓪ (**** Compiler-abhängige Definitionen ****)⓪ ⓪$TYPE Integer = SHORTINT; (* möglichst 16 Bit-Integer *)⓪ ⓪$CONST HZ = 200; (* time() RETURNs 1/200 second (Atari ST) *)⓪ ⓪ ⓪ (**** Compiler-/Library-abhängige Funktionen ****)⓪ ⓪$VAR hz200: LONGCARD;⓪ ⓪$(*$[-*)⓪$PROCEDURE readTimer;⓪$(*$[=*)⓪&VAR p: POINTER TO LONGCARD;⓪&BEGIN⓪(p:= ADDRESS (04BAH); (* Adr. des 200 Hz-Timers beim ST *)⓪(hz200:= p^⓪&END readTimer;⓪ ⓪$PROCEDURE time (): LONGCARD;⓪&(* Diese Funktion liest den 200 Hz-Timer des ST aus *)⓪&BEGIN⓪(SuperExec (readTimer);⓪(RETURN hz200⓪&END time;⓪ ⓪ (* für Systeme, die keine Compare-Funktion haben (z.B. FTL),⓪!* oder eine DEUTLICH zu langsame Compare-Funktion haben (z.B. SPC):⓪ ⓪$TYPE Relation = (less, equal, greater);⓪ ⓪$PROCEDURE Compare (VAR left, right: ARRAY OF CHAR): Relation;⓪&(*⓪'* Die VAR-Parameter sind für eine individuell auf diese⓪'* Testanwendung erstellte Funktion legitim. Dafür⓪'* bekommt das Modula-System aber auch gleich Minuspunkte,⓪'* weil es diese Funktion nicht bereitstellt!⓪'*)⓪&VAR high, idx: Integer; ch: CHAR;⓪&BEGIN⓪(IF HIGH (left) > HIGH (right) THEN⓪*high:= HIGH (right)⓪(ELSE⓪*high:= HIGH (left)⓪(END;⓪(idx:= 0;⓪(REPEAT⓪*ch:= left [idx];⓪*IF ch # right [idx] THEN⓪,IF ch > right [idx] THEN⓪.RETURN greater⓪,ELSE⓪.RETURN less⓪,END⓪*END;⓪*IF ch = 0C THEN⓪,RETURN equal⓪*END;⓪*INC (idx)⓪(UNTIL (idx > high);⓪(IF HIGH (left) = HIGH (right) THEN⓪*RETURN equal⓪(END;⓪(IF HIGH (left) > HIGH (right) THEN⓪*IF left [idx] = 0C THEN⓪,RETURN equal⓪*ELSE⓪,RETURN greater⓪*END⓪(ELSE⓪*IF right [idx] = 0C THEN⓪,RETURN equal⓪*ELSE⓪,RETURN less⓪*END⓪(END⓪&END Compare;⓪ *)⓪ ⓪ (**** Beginn des unabhängigen Programms *)⓪ ⓪ ⓪ CONST Version = "1.2";⓪ ⓪ CONST LOOPS = 10000; (* für ca. 10 - 20 Sekunden *)⓪ ⓪ ⓪ TYPE Enumeration = (Ident1, Ident2, Ident3, Ident4, Ident5);⓪ TYPE OneToThirty = Integer [1..30];⓪ TYPE OneToFifty = Integer [1..50];⓪ TYPE CapitalLetter = CHAR;⓪ TYPE String30 = ARRAY [0..30] OF CHAR;⓪ TYPE Array1Dim = ARRAY [0..50] OF Integer;⓪ TYPE Array2Dim = ARRAY [0..50],[0..50] OF Integer;⓪ ⓪ TYPE RecordPtr = POINTER TO RecordType;⓪ ⓪%RecordType = RECORD⓪8PtrComp : RecordPtr;⓪8Discr : Enumeration;⓪8EnumComp : Enumeration;⓪8IntComp : OneToFifty;⓪8StringComp: String30;⓪6END;⓪ ⓪ ⓪ (*⓪!* Package 1⓪!*)⓪ VAR⓪"IntGlob : Integer;⓪"BoolGlob : BOOLEAN;⓪"Char1Glob : CHAR;⓪"Char2Glob : CHAR;⓪"Array1Glob: Array1Dim;⓪"Array2Glob: Array2Dim;⓪"PtrGlb : RecordPtr;⓪"PtrGlbNext: RecordPtr;⓪ ⓪ ⓪ PROCEDURE Func1(CharPar1, CharPar2: CapitalLetter): Enumeration;⓪"VAR CharLoc1,⓪&CharLoc2 : CapitalLetter;⓪"BEGIN⓪$CharLoc1:= CharPar1;⓪$CharLoc2:= CharLoc1;⓪$IF (CharLoc2 # CharPar2) THEN⓪&RETURN Ident1⓪$ELSE⓪&RETURN Ident2⓪$END⓪"END Func1;⓪ ⓪ PROCEDURE Func2 ( VAR StrParI1, StrParI2: String30): BOOLEAN;⓪"VAR IntLoc: OneToThirty;⓪&CharLoc: CapitalLetter;⓪"BEGIN⓪$IntLoc:= 1;⓪$WHILE (IntLoc <= 1) DO⓪&IF (Func1 (StrParI1[IntLoc], StrParI2[IntLoc+1]) = Ident1) THEN⓪(CharLoc:= 'A';⓪(INC(IntLoc);⓪&END;⓪$END;⓪$IF (CharLoc >= 'W') & (CharLoc <= 'Z') THEN⓪&IntLoc:= 7;⓪$END;⓪$IF (CharLoc = 'X') THEN⓪&RETURN TRUE⓪$ELSE⓪&IF ( Compare(StrParI1, StrParI2) = greater) THEN⓪(INC(IntLoc,7);⓪(RETURN TRUE⓪&ELSE⓪(RETURN FALSE⓪&END⓪$END;⓪"END Func2;⓪ ⓪ PROCEDURE Func3(EnumParIn: Enumeration): BOOLEAN;⓪"VAR EnumLoc: Enumeration;⓪"BEGIN⓪$EnumLoc:= EnumParIn;⓪$HALT;⓪$IF (EnumLoc = Ident3) THEN⓪&RETURN TRUE⓪$END;⓪$RETURN FALSE⓪"END Func3;⓪ ⓪ ⓪ PROCEDURE Proc7 ( IntParI1, IntParI2: OneToFifty; VAR IntParOut: OneToFifty);⓪"VAR IntLoc: OneToFifty;⓪"BEGIN⓪$IntLoc:= IntParI1 + 2;⓪$IntParOut:= IntParI2 + IntLoc;⓪"END Proc7;⓪ ⓪ PROCEDURE Proc3(VAR PtrParOut : RecordPtr);⓪"BEGIN⓪$IF (PtrGlb # NIL) THEN⓪&PtrParOut := PtrGlb^.PtrComp;⓪$ELSE⓪&IntGlob := 100;⓪$END;⓪$Proc7(10, IntGlob, PtrGlb^.IntComp);⓪"END Proc3;⓪ ⓪ PROCEDURE Proc6(EnumParIn : Enumeration; VAR EnumParOut: Enumeration);⓪"BEGIN⓪$EnumParOut := EnumParIn;⓪$IF (~ Func3(EnumParIn) ) THEN⓪&EnumParOut := Ident4;⓪$END;⓪$CASE EnumParIn OF⓪&Ident1: EnumParOut := Ident1; |⓪&Ident2: IF (IntGlob > 100) THEN⓪0EnumParOut := Ident1⓪.ELSE⓪0EnumParOut := Ident4⓪.END |⓪&Ident3: EnumParOut := Ident2 |⓪&Ident4: |⓪&Ident5: EnumParOut := Ident3 |⓪$END;⓪"END Proc6;⓪ ⓪ PROCEDURE Proc1(PtrParIn : RecordPtr);⓪"BEGIN⓪$PtrParIn^.PtrComp^ := PtrGlb^;⓪$PtrParIn^.IntComp := 5;⓪$WITH PtrParIn^.PtrComp^ DO⓪&IntComp := PtrParIn^.IntComp;⓪&PtrComp := PtrParIn^.PtrComp;⓪&Proc3(PtrComp);⓪&IF (Discr = Ident1) THEN⓪(IntComp := 6;⓪(Proc6(PtrParIn^.EnumComp, EnumComp);⓪(PtrComp := PtrGlb^.PtrComp;⓪(Proc7(IntComp, 10, IntComp);⓪&ELSE⓪(PtrParIn := PtrParIn^.PtrComp;⓪&END;⓪$END;⓪"END Proc1;⓪ ⓪ PROCEDURE Proc2(VAR IntParIO : OneToFifty);⓪"VAR IntLoc : OneToFifty;⓪&EnumLoc : Enumeration;⓪"BEGIN⓪$IntLoc := IntParIO + 10;⓪$LOOP⓪&IF (Char1Glob = 'A') THEN⓪(DEC(IntLoc);⓪(IntParIO := IntLoc - IntGlob;⓪(EnumLoc := Ident1;⓪&END;⓪&IF (EnumLoc = Ident1) THEN⓪(EXIT⓪&END;⓪$END;⓪"END Proc2;⓪ ⓪ PROCEDURE Proc4();⓪"VAR BoolLoc : BOOLEAN;⓪"BEGIN⓪$BoolLoc := Char1Glob = 'A';⓪$BoolLoc := ~ BoolGlob;⓪$Char2Glob := 'B';⓪"END Proc4;⓪ ⓪ PROCEDURE Proc5();⓪"BEGIN⓪$Char1Glob := 'A';⓪$BoolGlob := FALSE;⓪"END Proc5;⓪ ⓪ PROCEDURE Proc8 ( VAR Array1Par: Array1Dim; VAR Array2Par: Array2Dim;⓪2IntParI1, IntParI2: OneToFifty);⓪"VAR IntLoc: OneToFifty;⓪&IntIndex: OneToFifty;⓪"BEGIN⓪$IntLoc:= IntParI1 + 5;⓪$Array1Par[IntLoc]:= IntParI2;⓪$Array1Par[IntLoc+1]:= Array1Par[IntLoc];⓪$Array1Par[IntLoc+30]:= IntLoc;⓪$FOR IntIndex:= IntLoc TO IntLoc+1 DO⓪&Array2Par[IntLoc][IntIndex]:= IntLoc;⓪$END;⓪$INC(Array2Par[IntLoc][IntLoc-1]);⓪$Array2Par[IntLoc+20][IntLoc]:= Array1Par[IntLoc];⓪$IntGlob:= 5;⓪"END Proc8;⓪ ⓪ PROCEDURE Proc0();⓪"⓪"PROCEDURE local;⓪$END local;⓪"⓪"VAR⓪$IntLoc1 : OneToFifty;⓪$IntLoc2 : OneToFifty;⓪$IntLoc3 : OneToFifty;⓪$CharLoc : CHAR;⓪$CharIndex : CHAR;⓪$EnumLoc : Enumeration;⓪$String1Loc : String30;⓪$String2Loc : String30;⓪$starttime : LONGCARD;⓪$benchtime : LONGCARD;⓪$nulltime : LONGCARD;⓪$i : [0..LOOPS];⓪ ⓪"BEGIN⓪$starttime := time();⓪$FOR i := 0 TO LOOPS-1 DO END;⓪$nulltime := time() - starttime; (* Computes overhead of loop *)⓪ ⓪$NEW (PtrGlbNext);⓪$NEW (PtrGlb);⓪$PtrGlb^.PtrComp := PtrGlbNext;⓪$PtrGlb^.Discr := Ident1;⓪$PtrGlb^.EnumComp := Ident3;⓪$PtrGlb^.IntComp := 40;⓪$PtrGlb^.StringComp := "DHRYSTONE PROGRAM, SOME STRING";⓪$String1Loc := "DHRYSTONE PROGRAM, 1'ST STRING"; (*GOOF*)⓪$Array2Glob[8][7] := 10;⓪ ⓪$(*****************⓪$-- Start Timer --⓪$*****************)⓪$⓪$starttime := time();⓪$⓪$FOR i := 0 TO LOOPS-1 DO⓪&Proc5();⓪&Proc4();⓪&IntLoc1 := 2;⓪&IntLoc2 := 3;⓪&String2Loc := "DHRYSTONE PROGRAM, 2'ND STRING";⓪&EnumLoc := Ident2;⓪&BoolGlob := ~ Func2(String1Loc, String2Loc);⓪&WHILE (IntLoc1 < IntLoc2) DO⓪(IntLoc3 := 5 * IntLoc1 - IntLoc2;⓪(Proc7(IntLoc1, IntLoc2, IntLoc3);⓪(INC(IntLoc1);⓪&END;⓪&Proc8(Array1Glob, Array2Glob, IntLoc1, IntLoc3);⓪&Proc1(PtrGlb);⓪&FOR CharIndex := 'A' TO Char2Glob DO⓪(IF (EnumLoc = Func1(CharIndex, 'C')) THEN⓪*Proc6(Ident1, EnumLoc);⓪(END;⓪&END;⓪&IntLoc3 := IntLoc2 * IntLoc1;⓪&IntLoc2 := IntLoc3 DIV IntLoc1;⓪&IntLoc2 := 7 * (IntLoc3 - IntLoc2) - IntLoc1;⓪&Proc2(IntLoc1);⓪$END;⓪$⓪ ⓪$(*****************⓪$-- Stop Timer --⓪$*****************)⓪ ⓪$benchtime := time() - starttime - nulltime;⓪ ⓪$WriteString("Modula-2 Dhrystone (");⓪$WriteString(Version);⓪$WriteString(") time for ");⓪$WriteCard(LOOPS,6);⓪$WriteString(" passes is ");⓪$WriteCard(benchtime DIV VAL (LONGCARD, HZ), 5);⓪$WriteLn;⓪$WriteString("This machine benchmarks at ");⓪$WriteCard(VAL (LONGCARD, LOOPS) * VAL (LONGCARD, HZ) DIV benchtime,6);⓪$WriteString(" dhrystones/second");⓪$WriteLn;⓪"END Proc0;⓪ ⓪ VAR ch: CHAR; add: ADDRESS;⓪ ⓪ BEGIN⓪"WriteLn;⓪"GetBasePageAddr (add);⓪"WriteLHex (add, 7);⓪"WriteLn;⓪"WriteString ("Running...");⓪"WriteLn;⓪"Proc0 ();⓪ END DhryTest.⓪ ə
- (* $FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$00002253$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22$FFED8C22Ç$00002274T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000057$FFEC668A$FFEC668A$000000B0$00000075$00002274$00002250$00002221$000022A9$00000023$000000B6$FFEC668A$000001EA$0000007F$00002256$00001A38ÿÇé*)
-
